home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / while-old.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  3.2 KB  |  114 lines  |  [TEXT/ALFA]
  1. # Commands covered:  while
  2. #
  3. # This file contains the original set of tests for Tcl's while command.
  4. # Since the while command is now compiled, a new set of tests covering
  5. # the new implementation is in the file "while.test". Sourcing this file
  6. # into Tcl runs the tests and generates output for errors.
  7. # No output means no errors were found.
  8. #
  9. # Copyright (c) 1991-1993 The Regents of the University of California.
  10. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15. # SCCS: @(#) while-old.test 1.14 97/05/16 10:44:19
  16.  
  17. if {[string compare test [info procs test]] == 1} then {source defs}
  18.  
  19. test while-old-1.1 {basic while loops} {
  20.     set count 0
  21.     while {$count < 10} {set count [expr $count+1]}
  22.     set count
  23. } 10
  24. test while-old-1.2 {basic while loops} {
  25.     set value xxx
  26.     while {2 > 3} {set value yyy}
  27.     set value
  28. } xxx
  29. test while-old-1.3 {basic while loops} {
  30.     set value 1
  31.     while {"true"} {
  32.     incr value;
  33.     if {$value > 5} {
  34.         break;
  35.     }
  36.     }
  37.     set value
  38. } 6
  39. test while-old-1.4 {basic while loops, multiline test expr} {
  40.     set value 1
  41.     while {($tcl_platform(platform) != "foobar1") && \
  42.         ($tcl_platform(platform) != "foobar2")} {
  43.         incr value
  44.         break
  45.     }
  46.     set value
  47. } {2}
  48. test while-old-1.5 {basic while loops, test expr in quotes} {
  49.     set value 1
  50.     while "0 < 3" {set value 2; break}
  51.     set value
  52. } {2}
  53.  
  54. test while-old-2.1 {continue in while loop} {
  55.     set list {1 2 3 4 5}
  56.     set index 0
  57.     set result {}
  58.     while {$index < 5} {
  59.     if {$index == 2} {set index [expr $index+1]; continue}
  60.     set result [concat $result [lindex $list $index]]
  61.     set index [expr $index+1]
  62.     }
  63.     set result
  64. } {1 2 4 5}
  65.  
  66. test while-old-3.1 {break in while loop} {
  67.     set list {1 2 3 4 5}
  68.     set index 0
  69.     set result {}
  70.     while {$index < 5} {
  71.     if {$index == 3} break
  72.     set result [concat $result [lindex $list $index]]
  73.     set index [expr $index+1]
  74.     }
  75.     set result
  76. } {1 2 3}
  77.  
  78. test while-old-4.1 {errors in while loops} {
  79.     set err [catch {while} msg]
  80.     list $err $msg
  81. } {1 {wrong # args: should be "while test command"}}
  82. test while-old-4.2 {errors in while loops} {
  83.     set err [catch {while 1} msg]
  84.     list $err $msg
  85. } {1 {wrong # args: should be "while test command"}}
  86. test while-old-4.3 {errors in while loops} {
  87.     set err [catch {while 1 2 3} msg]
  88.     list $err $msg
  89. } {1 {wrong # args: should be "while test command"}}
  90. test while-old-4.4 {errors in while loops} {
  91.     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
  92.     list $err $msg
  93. } {1 {can't use non-numeric string as operand of "+"}}
  94. test while-old-4.5 {errors in while loops} {
  95.     catch {unset x}
  96.     set x 1
  97.     set err [catch {while {$x} {set x foo}} msg]
  98.     list $err $msg
  99. } {1 {expected boolean value but got "foo"}}
  100. test while-old-4.6 {errors in while loops} {
  101.     set err [catch {while {1} {error "loop aborted"}} msg]
  102.     list $err $msg $errorInfo
  103. } {1 {loop aborted} {loop aborted
  104.     while executing
  105. "error "loop aborted""}}
  106.  
  107. test while-old-5.1 {while return result} {
  108.     while {0} {set a 400}
  109. } {}
  110. test while-old-5.2 {while return result} {
  111.     set x 1
  112.     while {$x} {set x 0}
  113. } {}
  114.